home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / toxetris / tetris.bas < prev    next >
Encoding:
BASIC Source File  |  1999-09-30  |  15.8 KB  |  333 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. 'Only one API declaration
  4. 'from The Visual Basic 5.0 API declarations document
  5. 'Win32API.txt
  6. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  7. Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  8. Public Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  9. Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  10. Public Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
  11. Public Const SRCERASE = &H440328        ' (DWORD) dest = source AND (NOT dest )
  12. Public Const NOTSRCCOPY = &H330008      ' (DWORD) dest = (NOT source)
  13. Public Const NOTSRCERASE = &H1100A6     ' (DWORD) dest = (NOT src) AND (NOT dest)
  14.  
  15. Public Type ONE_PIECE
  16.    Width As Long
  17.    Height As Long
  18.    OnBmp_x As Long 'x pos of the piece on the Pieces.BMP file
  19.    OnBmp_y As Long 'y pos
  20.    MaskOnBmp_x As Long 'x pos of the mask on the Pieces.BMP file
  21.    MaskOnBmp_y As Long 'y pos
  22.    Creating_x As Long 'Center the piece on release
  23.    Creating_Piece_No As Long 'Allways release the good one.
  24.    Next_Piece_Pos_x As Long 'Center the piece on the next piece window
  25.    Next_Piece_Pos_y As Long 'Same
  26.    After_Turn_Piece_No As Long 'Which one will be the next piece after turn
  27.    After_Turn_dx As Long 'if it will turn, how much will
  28.    After_Turn_dy As Long 'be the x,y differences on turn
  29.    Number_Of_Positions_To_Check_Left As Long 'Number of positions To check on the left, right and down
  30.    Number_Of_Positions_To_Check_Right As Long
  31.    Number_Of_Positions_To_Check_Down As Long
  32.    Check_These_Positions_Left_x(9) As Long 'X and Y coordinates of the Positions to check if empty or not
  33.    Check_These_Positions_Left_y(9) As Long
  34.    Check_These_Positions_Right_x(9) As Long
  35.    Check_These_Positions_Right_y(9) As Long
  36.    Check_These_Positions_Down_x(9) As Long
  37.    Check_These_Positions_Down_y(9) As Long
  38.    Number_Of_Squares As Long 'It is allways equal to 4
  39.    Piece_Is_This_x(4) As Long
  40.    Piece_Is_This_y(4) As Long
  41. End Type
  42.  
  43. Type PIECE_PERMISSIONS
  44.    Left(1 To 18, 0 To 11) As Boolean
  45.    Right(1 To 18, 0 To 11) As Boolean
  46.    Vertical(1 To 18, 0 To 11) As Boolean
  47.    Left2(1 To 18, 0 To 11) As Boolean
  48.    Right2(1 To 18, 0 To 11) As Boolean
  49.    Vertical2(1 To 18, 0 To 11) As Boolean
  50. End Type
  51.  
  52. Public Piece(19) As ONE_PIECE
  53. Public Piece_No_Permission As PIECE_PERMISSIONS
  54. Public Score As Long
  55. Public Vertical_Stop_Time As Single
  56. Public Vx As Single
  57. Public Vy As Single
  58. Public Vy_Level As Single
  59. Public Level As Long
  60. Public x As Single
  61. Public y As Single
  62. Public Prv_x As Single
  63. Public Prv_y As Single
  64. Public Piece_No As Long
  65. Public Prv_Piece_No As Long
  66. Public Next_Piece_No As Long
  67. Public Position_Empty(1 To 18, 0 To 11) As Boolean
  68. Public Copied_To_BMP As Boolean
  69. Public Game_Is_Started As Boolean
  70. Public Game_Is_About_To_End As Boolean
  71. Public Key_Up As Boolean
  72. Public Vertical_Stop_Status As Boolean
  73. Public Left_Stop_Status As Boolean
  74. Public Right_Stop_Status As Boolean
  75. Public Prv_Vertical_Stop_Status As Boolean
  76. Public Prv_Left_Stop_Status As Boolean
  77. Public Prv_Right_Stop_Status As Boolean
  78. Public Right_Move_Requested As Boolean
  79. Public Left_Move_Requested As Boolean
  80. Public Piece_Stopped As Boolean
  81. Sub Draw_The_Piece(DTP_Prv_Piece_No As Long, DTP_Piece_No As Long, DTP_x As Long, DTP_y As Long, DTP_Px As Long, DTP_Py As Long)
  82.    'First, copy the previous background back
  83.    'Then copy the new position content to a blank area on picture box BMP
  84.    'Draw the mask
  85.    'and draw the piece to its new position.
  86.       If Copied_To_BMP = True Then BitBlt Form1.Picture1.hDC, DTP_Px, DTP_Py, Piece(DTP_Prv_Piece_No).Width, Piece(DTP_Prv_Piece_No).Height, Form1.BMP.hDC, 408, 240, SRCCOPY
  87.       BitBlt Form1.BMP.hDC, 408, 240, Piece(DTP_Piece_No).Width, Piece(DTP_Piece_No).Height, Form1.Picture1.hDC, DTP_x, DTP_y, SRCCOPY
  88.       Copied_To_BMP = True
  89.       BitBlt Form1.Picture1.hDC, DTP_x, DTP_y, Piece(DTP_Piece_No).Width, Piece(DTP_Piece_No).Height, Form1.BMP.hDC, Piece(DTP_Piece_No).MaskOnBmp_x, Piece(DTP_Piece_No).MaskOnBmp_y, SRCAND
  90.       BitBlt Form1.Picture1.hDC, DTP_x, DTP_y, Piece(DTP_Piece_No).Width, Piece(DTP_Piece_No).Height, Form1.BMP.hDC, Piece(DTP_Piece_No).OnBmp_x, Piece(DTP_Piece_No).OnBmp_y, SRCPAINT
  91.       Form1.Picture1.Refresh
  92. End Sub
  93.  
  94. Public Function Get_A_Piece() As Long
  95.    Get_A_Piece = 1 + Int(Rnd * 19)
  96. End Function
  97.  
  98. Sub Check_The_Permissions(CTP_Piece_No As Long, CTP_x As Single, CTP_y As Single, CTP_Vx As Single, CTP_Vy As Single)
  99. Dim CTP_x_Pos
  100. Dim CTP_y_Pos
  101. CTP_x_Pos = Int(CTP_x / 24) + 1
  102. CTP_y_Pos = Int((CTP_y + CTP_Vy) / 24) + 1
  103. Vertical_Stop_Status = False
  104. Right_Stop_Status = False
  105. Left_Stop_Status = False
  106. If Int((CTP_y + CTP_Vy) / 24) > Int(CTP_y / 24) Or Int(CTP_y) Mod 24 = 0 Then
  107.    Vertical_Stop_Status = False
  108.    If Int(CTP_x) Mod 24 = 0 Then
  109.       If Piece_No_Permission.Vertical(CTP_y_Pos, CTP_x_Pos) = True Then
  110.          y = Int((CTP_y + CTP_Vy) / 24) * 24: Vy = 0: Vertical_Stop_Status = True
  111.          If Vertical_Stop_Time = 0 Then Vertical_Stop_Time = Timer
  112.          If Vertical_Stop_Time > 0 And Timer - Vertical_Stop_Time > 0.5 Then Stop_The_Piece CTP_Piece_No, CTP_x, CTP_y: Exit Sub
  113.       End If
  114.    Else
  115.       If Piece_No_Permission.Vertical(CTP_y_Pos, CTP_x_Pos) = True Or Piece_No_Permission.Vertical2(CTP_y_Pos, CTP_x_Pos) = True Then
  116.          y = Int((CTP_y + CTP_Vy) / 24) * 24: Vy = 0: Vertical_Stop_Status = True
  117.          If Vertical_Stop_Time > 0 And Timer - Vertical_Stop_Time > 0.5 Then Stop_The_Piece CTP_Piece_No, CTP_x, CTP_y: Exit Sub
  118.          If Vertical_Stop_Time = 0 Then Vertical_Stop_Time = Timer
  119.       End If
  120.    End If
  121.    If Vertical_Stop_Status = False And Vy = 0 Then Vy = Vy_Level
  122. End If
  123. If Int((CTP_x + CTP_Vx) / 24) < Int(CTP_x / 24) Or Int(CTP_x) Mod 24 = 0 Then
  124.    Left_Stop_Status = False
  125.    If Int(CTP_y) Mod 24 = 0 Then
  126.       If Piece_No_Permission.Left(CTP_y_Pos, CTP_x_Pos - 1) = True Then
  127.          x = Int(CTP_x / 24) * 24: Vx = 0: Left_Stop_Status = True
  128.       End If
  129.    Else
  130.       If Piece_No_Permission.Left(CTP_y_Pos, CTP_x_Pos - 1) = True Or Piece_No_Permission.Left2(CTP_y_Pos, CTP_x_Pos - 1) = True Then
  131.          x = Int(CTP_x / 24) * 24: Vx = 0: Left_Stop_Status = True
  132.       End If
  133.    End If
  134. End If
  135. If Int((CTP_x + CTP_Vx) / 24) > Int(CTP_x / 24) Or Int(CTP_x) Mod 24 = 0 Then
  136.    Right_Stop_Status = False
  137.    If Int(y) Mod 24 = 0 Then
  138.       If Piece_No_Permission.Right(CTP_y_Pos, CTP_x_Pos) = True Then
  139.          x = Int(CTP_x / 24) * 24: Vx = 0: Right_Stop_Status = True
  140.       End If
  141.    Else
  142.       If Piece_No_Permission.Right(CTP_y_Pos, CTP_x_Pos) = True Or Piece_No_Permission.Right2(CTP_y_Pos, CTP_x_Pos) = True Then
  143.          x = Int(CTP_x / 24) * 24: Vx = 0: Right_Stop_Status = True
  144.       End If
  145.    End If
  146. End If
  147. If Prv_Right_Stop_Status = True And Right_Stop_Status = False And Right_Move_Requested = True Then
  148.    x = x + 1: Vx = 0.1: Exit Sub
  149. End If
  150. If Vertical_Stop_Status = False Then Vertical_Stop_Time = 0
  151. If Prv_Vertical_Stop_Status = True And Vertical_Stop_Status = False Then
  152.    y = y + 1: Vy = Vy_Level: Exit Sub
  153. End If
  154. If Right_Move_Requested = True And Left_Stop_Status = True And Right_Stop_Status = False Then Vx = 0.1: x = x + 1
  155. If Left_Move_Requested = True And Right_Stop_Status = True And Left_Stop_Status = False Then Vx = -0.1: x = x - 1
  156. End Sub
  157.  
  158. Sub Create_Permission_Database(CPD_Piece_no As Long)
  159. Dim CPD_1 As Long
  160. Dim CPD_2 As Long
  161. Dim CPD_3 As Long
  162. Dim CPD_4 As Long
  163. Dim CPD_5 As Long
  164. For CPD_1 = 1 To 18
  165.    For CPD_2 = 0 To 11
  166.       Piece_No_Permission.Vertical(CPD_1, CPD_2) = False
  167.       Piece_No_Permission.Vertical2(CPD_1, CPD_2) = False
  168.       Piece_No_Permission.Left(CPD_1, CPD_2) = False
  169.       Piece_No_Permission.Left2(CPD_1, CPD_2) = False
  170.       Piece_No_Permission.Right(CPD_1, CPD_2) = False
  171.       Piece_No_Permission.Right2(CPD_1, CPD_2) = False
  172.       If Position_Empty(CPD_1, CPD_2) = False Then
  173.          For CPD_3 = 1 To Piece(CPD_Piece_no).Number_Of_Positions_To_Check_Down
  174.             CPD_4 = CPD_1 - Piece(CPD_Piece_no).Check_These_Positions_Down_y(CPD_3)
  175.             CPD_5 = CPD_2 - Piece(CPD_Piece_no).Check_These_Positions_Down_x(CPD_3)
  176.             If CPD_2 <> 0 And CPD_2 <> 11 Then
  177.                If CPD_4 > 0 And CPD_5 > 0 And CPD_5 < 11 Then
  178.                   Piece_No_Permission.Vertical(CPD_4, CPD_5) = True
  179.                End If
  180.                If CPD_4 > 0 And CPD_5 - 1 > 0 And CPD_5 - 1 < 11 Then
  181.                   Piece_No_Permission.Vertical2(CPD_4, CPD_5 - 1) = True
  182.                End If
  183.             End If
  184.          Next CPD_3
  185.          For CPD_3 = 1 To Piece(CPD_Piece_no).Number_Of_Positions_To_Check_Left
  186.             CPD_4 = CPD_1 - Piece(CPD_Piece_no).Check_These_Positions_Left_y(CPD_3)
  187.             CPD_5 = CPD_2 - Piece(CPD_Piece_no).Check_These_Positions_Left_x(CPD_3)
  188.             If CPD_1 <> 18 Then
  189.                If CPD_4 > 0 And CPD_5 - 1 > 0 And CPD_5 - 1 < 11 Then
  190.                   Piece_No_Permission.Left(CPD_4, CPD_5 - 1) = True
  191.                End If
  192.                If CPD_4 - 1 > 0 And CPD_5 - 1 > 0 And CPD_5 - 1 < 11 Then
  193.                   Piece_No_Permission.Left2(CPD_4 - 1, CPD_5 - 1) = True
  194.                End If
  195.             End If
  196.          Next CPD_3
  197.          For CPD_3 = 1 To Piece(CPD_Piece_no).Number_Of_Positions_To_Check_Right
  198.             CPD_4 = CPD_1 - Piece(CPD_Piece_no).Check_These_Positions_Right_y(CPD_3)
  199.             CPD_5 = CPD_2 - Piece(CPD_Piece_no).Check_These_Positions_Right_x(CPD_3)
  200.             If CPD_1 <> 18 Then
  201.                If CPD_4 > 0 And CPD_5 > 0 And CPD_5 < 11 Then
  202.                   Piece_No_Permission.Right(CPD_4, CPD_5) = True
  203.                End If
  204.                If CPD_4 - 1 > 0 And CPD_5 > 0 And CPD_5 < 11 Then
  205.                   Piece_No_Permission.Right2(CPD_4 - 1, CPD_5) = True
  206.                End If
  207.             End If
  208.          Next CPD_3
  209.       End If
  210.    Next CPD_2
  211. Next CPD_1
  212. End Sub
  213.  
  214. Sub Stop_The_Piece(STP_Piece_No As Long, STP_x As Single, STP_y As Single)
  215. Vertical_Stop_Time = 0
  216. Dim STP_x_Pos
  217. Dim STP_y_Pos
  218. Dim STP_i As Long
  219. Dim STP_Tmp1 As Long
  220. Dim STP_Tmp2 As Long
  221. STP_x_Pos = Int(STP_x / 24) + 1
  222. STP_y_Pos = Int((STP_y) / 24) + 1
  223. Check_The_Permissions Piece_No, (STP_x_Pos - 1) * 24, y, 0, 0
  224. If Vertical_Stop_Status = False Then
  225.    STP_x_Pos = STP_x_Pos + 1
  226. Else
  227.    If x - (STP_x_Pos - 1) * 24 > 12 Then
  228.       Check_The_Permissions Piece_No, (STP_x_Pos) * 24, y, 0, 0
  229.       If Vertical_Stop_Status = True Then
  230.          STP_x_Pos = STP_x_Pos + 1
  231.       End If
  232.    End If
  233. End If
  234. x = (STP_x_Pos - 1) * 24
  235. y = (STP_y_Pos - 1) * 24
  236. Piece_Stopped = True
  237. For STP_i = 1 To Piece(STP_Piece_No).Number_Of_Squares
  238.    STP_Tmp1 = STP_y_Pos + Piece(STP_Piece_No).Piece_Is_This_y(STP_i)
  239.    STP_Tmp2 = STP_x_Pos + Piece(STP_Piece_No).Piece_Is_This_x(STP_i)
  240.    Position_Empty(STP_Tmp1, STP_Tmp2) = False
  241. Next STP_i
  242. End Sub
  243.  
  244. Public Function Turn_Permission(TP_Piece_No As Long, TP_x As Single, TP_Y As Single, TP_Current As Boolean) As Boolean
  245. Dim TP_New_Piece_No As Long
  246. Dim TP_New_x As Single
  247. Dim TP_New_y As Single
  248. Dim TP_x_Pos As Long
  249. Dim TP_y_Pos As Long
  250. Dim TP_i As Long
  251. TP_New_Piece_No = Piece(TP_Piece_No).After_Turn_Piece_No
  252. TP_New_x = TP_x + Piece(TP_Piece_No).After_Turn_dx
  253. TP_New_y = TP_Y + Piece(TP_Piece_No).After_Turn_dy
  254. If TP_Current = True Then
  255.    TP_New_Piece_No = TP_Piece_No
  256.    TP_New_x = Piece(TP_New_Piece_No).Creating_x
  257.    TP_New_y = 1
  258. End If
  259. TP_x_Pos = Int(TP_New_x / 24) + 1
  260. TP_y_Pos = Int(TP_New_y / 24) + 1
  261. If TP_New_x < 0 Or TP_New_x + Piece(TP_New_Piece_No).Width > 240 Then Turn_Permission = False: Exit Function
  262. If TP_New_y < 0 Or TP_New_y + Piece(TP_New_Piece_No).Height > 384 Then Turn_Permission = False: Exit Function
  263. For TP_i = 1 To Piece(TP_New_Piece_No).Number_Of_Squares
  264.    If Int(TP_New_x) Mod 24 = 0 Then
  265.       If Int(TP_New_y) Mod 24 = 0 Then
  266.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  267.       Else
  268.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  269.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i) + 1, TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  270.       End If
  271.    Else
  272.       If Int(TP_New_y) Mod 24 = 0 Then
  273.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  274.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i) + 1) = False Then Turn_Permission = False: Exit Function
  275.       Else
  276.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Or Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i) + 1, TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  277.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i) + 1, TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Or Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i) + 1, TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Then Turn_Permission = False: Exit Function
  278.          If Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i), TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i)) = False Or Position_Empty(TP_y_Pos + Piece(TP_New_Piece_No).Piece_Is_This_y(TP_i) + 1, TP_x_Pos + Piece(TP_New_Piece_No).Piece_Is_This_x(TP_i) + 1) = False Then Turn_Permission = False: Exit Function
  279.       End If
  280.    End If
  281. Next TP_i
  282. Turn_Permission = True
  283. End Function
  284.  
  285. Sub Check_Rows_After_Stop()
  286. Dim CRAS_i As Long
  287. Dim CRAS_j As Long
  288. Dim CRAS_k As Long
  289. Dim CRAS_Rows_To_Delete(1 To 4) As Long
  290. Dim CRAS_Tmp As Long
  291. CRAS_Tmp = 1
  292. For CRAS_i = 17 To 1 Step -1
  293.    For CRAS_j = 1 To 10
  294.       If Position_Empty(CRAS_i, CRAS_j) = True Then GoTo At_Least_One_Position_Is_Empty
  295.    Next CRAS_j
  296.    CRAS_Rows_To_Delete(CRAS_Tmp) = CRAS_i
  297.    CRAS_Tmp = CRAS_Tmp + 1
  298.    If CRAS_Tmp = 5 Then Exit For
  299. At_Least_One_Position_Is_Empty:
  300. Next CRAS_i
  301. CRAS_Rows_To_Delete(2) = CRAS_Rows_To_Delete(2) + 1
  302. CRAS_Rows_To_Delete(3) = CRAS_Rows_To_Delete(3) + 2
  303. CRAS_Rows_To_Delete(4) = CRAS_Rows_To_Delete(4) + 3
  304. If CRAS_Tmp > 1 Then
  305.    Score = Score + 100 * (2 ^ (CRAS_Tmp - 1)) * Level
  306.    For CRAS_i = 1 To CRAS_Tmp - 1
  307.       Form1.Picture1.Line (0, (CRAS_Rows_To_Delete(CRAS_i) - 1) * 24)-(244, (CRAS_Rows_To_Delete(CRAS_i) - 1) * 24 + 23), RGB(0, 0, 0), BF
  308.       BitBlt Form1.Picture1.hDC, 0, 24, Form1.Picture1.Width, (CRAS_Rows_To_Delete(CRAS_i) - 1) * 24, Form1.Picture1.hDC, 0, 0, SRCCOPY
  309.       Form1.Picture1.Line (0, 0)-(244, 25), RGB(0, 0, 0), BF
  310.       Form1.Picture1.Line (0, 0)-(244, 0), RGB(64, 64, 64)
  311.       Form1.Picture1.Line (0, 24)-(244, 24), RGB(64, 64, 64)
  312.       For CRAS_j = 240 To 0 Step -24
  313.          Form1.Picture1.Line (CRAS_j, 0)-(CRAS_j, 24), RGB(64, 64, 64)
  314.       Next CRAS_j
  315.       For CRAS_j = 240 To 0 Step -24
  316.          For CRAS_k = 0 To 24 Step 24
  317.             Form1.Picture1.PSet (CRAS_j, CRAS_k), RGB(96, 96, 96)
  318.          Next CRAS_k
  319.       Next CRAS_j
  320.       Form1.Picture1.Refresh
  321.       For CRAS_j = CRAS_Rows_To_Delete(CRAS_i) To 2 Step -1
  322.          For CRAS_k = 1 To 10
  323.             Position_Empty(CRAS_j, CRAS_k) = Position_Empty(CRAS_j - 1, CRAS_k)
  324.          Next CRAS_k
  325.       Next CRAS_j
  326.       For CRAS_k = 1 To 10
  327.          Position_Empty(1, CRAS_k) = True
  328.       Next CRAS_k
  329.    Next CRAS_i
  330. End If
  331. End Sub
  332.  
  333.